課題1:次の自動車課題について「データセット」を探し,データ分析を行う。

データセット

データセットの呼び出しを行う

データの読み込み(インポート)

  1. データの読み込み(※ディレクトリについて) ここでは,主にCSV(Comma Separated Values)ファイルの読み込みについて説明する。 (注)ディレクトリについて ・Windowsではメニュー「ファイル」→「ディレクトリの変更」で指定できる ・Macではメニュー「その他」→「作業ディレクトリの変更」 実際に,それぞれの環境の中でデータを読み込むときは,ディレクトリの理解が不可欠になる。 例えば,JドライブのRフォルダにある”sheet1.csv”を読み込むときは次のようにする (学院のPC教室ではJドライブに資料を格納しておく)。
# データを読み込む
cars <- read.csv("J:/R/cars.csv")

1. データの提示

head(cars)
##   speed dist
## 1     4    2
## 2     4   10
## 3     7    4
## 4     7   22
## 5     8   16
## 6     9   10

2.基本統計量の計算

平均値・最大値・最小値・中央値

summary(cars)
##      speed           dist       
##  Min.   : 4.0   Min.   :  2.00  
##  1st Qu.:12.0   1st Qu.: 26.00  
##  Median :15.0   Median : 36.00  
##  Mean   :15.4   Mean   : 42.98  
##  3rd Qu.:19.0   3rd Qu.: 56.00  
##  Max.   :25.0   Max.   :120.00

不偏分散

lapply(cars[,1:2], var)
## $speed
## [1] 27.95918
## 
## $dist
## [1] 664.0608

不偏標準偏差

lapply(cars[,1:2], sd)
## $speed
## [1] 5.287644
## 
## $dist
## [1] 25.76938

3.相関係数の計算

cor(cars[,1], cars[,2])
## [1] 0.8068949

4. 線形モデルの生成

cars.lm <- lm(dist ~ speed, data = cars)

回帰直線を方程式を求める 

coef(cars.lm)
## (Intercept)       speed 
##  -17.579095    3.932409

上記の結果から、今回の回帰係数は、切片が-17.5790949で、傾きが3.9324088であることがわかる。これを線形の式に直すと、以下の通りになる。

\[ dist = -17.5790949 + 3.9324088 \times speed \]

5. 散布図および回帰直線の描画

plot(cars[,1:2],
     xlab = "",
     ylab = "")
abline(cars.lm)

6.残差(テキストp.83)の絶対値が比較的大きいデータに注目し、自身の考察を書きなさい。

残差を求める

# define the dataset `cars_result`
cars_result <- data.frame(cars, 
                      resid = resid(cars.lm), # residuals of the linear model
                      resid_abs = abs(resid(cars.lm)) # absolute value of the residuals
                      )

並び替える

# order `cars_result` 
head(cars_result[sort(cars_result$resid_abs, decreasing = T, index = T)[[2]],], n = 10)
##    speed dist     resid resid_abs
## 49    24  120  43.20128  43.20128
## 23    14   80  42.52537  42.52537
## 35    18   84  30.79574  30.79574
## 39    20   32 -29.06908  29.06908
## 34    18   76  22.79574  22.79574
## 22    14   60  22.52537  22.52537
## 24    15   20 -21.40704  21.40704
## 36    19   36 -21.13667  21.13667
## 45    23   54 -18.86631  18.86631
## 29    17   32 -17.27185  17.27185

7.自己ワーク

国土交通省の資料「安全な車に乗ろう」 国土交通省の資料「安全な車に乗ろう」なども参考にし,安全な自動車を設計するために必要な実験や調査を考えたとき,対象となる変量はどのようなものが考えられるだろうか。そして,そこにはどのような因果関係があるか考察しよう。

  • 対象となる変数

    • ABSの有無
  • 仮説

    • ABSの有無がそのスピードから停止する距離に影響する。
  • 実験 ABSを装備した自動車のと、通常のブレーキを装備した自動車のグループを用意し、同じ条件下で、あるスピードから停止するのにかかる時間を計測する。その後、スピードを説明変数とし、停止距離を目的変数とした回帰モデルにおけるそれぞれの傾きを比較し、ABSが装備されているか否かで停止距離に影響があるのかを検証する。

  • 回帰モデル ABSを装備した自動車をAグループとし、通常のブレーキを装備した自動車をBグループとする。

\[ dist_A = \beta_{1_A} + \beta_{2_A} speed_A + u_A \]

\[ dist_B = \beta_{1_B} + \beta_{2_B} speed_B + u_B \]

上記の回帰モデルを走らせた後、\(\beta_{2_A}\)\(\beta_{2_B}\)を比べ、違いがあるのかを検証する。

ファイル提出

コード等をwordに貼って、ファイルを提出する

課題2:自分の関心のある課題について「データセット」を探しデータ分析を行い,その結果について回帰分析を考察する。

  • 対象となる変数
    • 説明変数: 攻撃力
    • 目的変数: 防御力
  • 仮説
    • 防御力が強くなると、攻撃力も強くなる傾向がある。

データセットの呼び出しを行う

データの読み込み(インポート)

  1. データの読み込み(※ディレクトリについて) ここでは,主にCSV(Comma Separated Values)ファイルの読み込みについて説明する。 (注)ディレクトリについて ・Windowsではメニュー「ファイル」→「ディレクトリの変更」で指定できる ・Macではメニュー「その他」→「作業ディレクトリの変更」 実際に,それぞれの環境の中でデータを読み込むときは,ディレクトリの理解が不可欠になる。 例えば,JドライブのRフォルダにある”sheet1.csv”を読み込むときは次のようにする (学院のPC教室ではJドライブに資料を格納しておく)。
# データを読み込む
data <- read.csv("J:/R/data.csv")

1. データの提示

head(data)
##   X                     name year selling_price km_driven   fuel seller_type
## 1 1            Maruti 800 AC 2007         60000     70000 Petrol  Individual
## 2 2 Maruti Wagon R LXI Minor 2007        135000     50000 Petrol  Individual
## 3 3     Hyundai Verna 1.6 SX 2012        600000    100000 Diesel  Individual
## 4 4   Datsun RediGO T Option 2017        250000     46000 Petrol  Individual
## 5 5    Honda Amaze VX i-DTEC 2014        450000    141000 Diesel  Individual
## 6 6     Maruti Alto LX BSIII 2007        140000    125000 Petrol  Individual
##   transmission        owner
## 1       Manual  First Owner
## 2       Manual  First Owner
## 3       Manual  First Owner
## 4       Manual  First Owner
## 5       Manual Second Owner
## 6       Manual  First Owner

2.基本統計量の計算

平均値・最大値・最小値・中央値

summary(data)
##        X            name                year      selling_price    
##  Min.   :   1   Length:4340        Min.   :1992   Min.   :  20000  
##  1st Qu.:1086   Class :character   1st Qu.:2011   1st Qu.: 208750  
##  Median :2170   Mode  :character   Median :2014   Median : 350000  
##  Mean   :2170                      Mean   :2013   Mean   : 504127  
##  3rd Qu.:3255                      3rd Qu.:2016   3rd Qu.: 600000  
##  Max.   :4340                      Max.   :2020   Max.   :8900000  
##    km_driven          fuel           seller_type        transmission      
##  Min.   :     1   Length:4340        Length:4340        Length:4340       
##  1st Qu.: 35000   Class :character   Class :character   Class :character  
##  Median : 60000   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 66216                                                           
##  3rd Qu.: 90000                                                           
##  Max.   :806599                                                           
##     owner          
##  Length:4340       
##  Class :character  
##  Mode  :character  
##                    
##                    
## 

不偏分散

lapply(data[,4:5], var)
## $selling_price
## [1] 334718640088
## 
## $km_driven
## [1] 2175672269

不偏標準偏差

lapply(data[,4:5], sd)
## $selling_price
## [1] 578548.7
## 
## $km_driven
## [1] 46644.1

3.相関係数の計算

cor(data[,4], data[,5])
## [1] -0.1922886

4. 線形モデルの生成

data.lm <- lm(selling_price ~ km_driven, data = data)

回帰直線を方程式を求める 

coef(data.lm)
##   (Intercept)     km_driven 
## 662055.007854     -2.385046

上記の結果から、今回の回帰係数は、切片が6.620550110^{5}で、傾きが-2.3850463であることがわかる。これを線形の式に直すと、以下の通りになる。

\[ selling_price = 6.6205501\times 10^{5} + -2.3850463 \times km_driven \]

5. 散布図および回帰直線の描画

plot(data$km_driven, data$selling_price
     # xlab = "",
     # ylab = ""
     )
abline(data.lm)

6.残差(テキストp.83)の絶対値が比較的大きいデータに注目し、自身の考察を書きなさい。

残差を求める

# define the dataset `data_result`
data_result <- data.frame(data, 
                      resid = resid(data.lm), # residuals of the linear model
                      resid_abs = abs(resid(data.lm)) # absolute value of the residuals
                      )

並び替える

# order `data_result` 
head(data_result[sort(data_result$resid_abs, decreasing = T, index = T)[[2]],], n = 10)
##         X                                              name year selling_price
## 3873 3873          Audi RS7 2015-2019 Sportback Performance 2016       8900000
## 90     90 Mercedes-Benz S-Class S 350d Connoisseurs Edition 2017       8150000
## 3970 3970           Mercedes-Benz GLS 2016-2020 350d 4MATIC 2016       5500000
## 556   556                           BMW X5 xDrive 30d xLine 2019       4950000
## 575   575                           BMW X5 xDrive 30d xLine 2019       4950000
## 594   594                           BMW X5 xDrive 30d xLine 2019       4950000
## 613   613                           BMW X5 xDrive 30d xLine 2019       4950000
## 901   901                           BMW X5 xDrive 30d xLine 2019       4950000
## 920   920                           BMW X5 xDrive 30d xLine 2019       4950000
## 1024 1024                           BMW X5 xDrive 30d xLine 2019       4950000
##      km_driven   fuel seller_type transmission       owner   resid resid_abs
## 3873     13000 Petrol      Dealer    Automatic First Owner 8268951   8268951
## 90        6500 Diesel      Dealer    Automatic First Owner 7503448   7503448
## 3970     77350 Diesel      Dealer    Automatic First Owner 5022428   5022428
## 556      30000 Diesel      Dealer    Automatic First Owner 4359496   4359496
## 575      30000 Diesel      Dealer    Automatic First Owner 4359496   4359496
## 594      30000 Diesel      Dealer    Automatic First Owner 4359496   4359496
## 613      30000 Diesel      Dealer    Automatic First Owner 4359496   4359496
## 901      30000 Diesel      Dealer    Automatic First Owner 4359496   4359496
## 920      30000 Diesel      Dealer    Automatic First Owner 4359496   4359496
## 1024     30000 Diesel      Dealer    Automatic First Owner 4359496   4359496

考察

  • 仮説:中古車ののデータから、走行距離が売却価格に対して負の影響をもつ。

  • モデルの説明

    • 目的変数: 売却価格
    • 説明変数: 走行距離
  • 結果 (モデルの係数の説明)  うまくいかなかった。残渣を見ればわかる。

  • 考察 (なぜうまくいかなかったのか)

    • ブランド車に対して、回帰直線のモデルがうまく説明できていないのではないか。ブランドごとに回帰直線を回したほうがいいのかもしれない。
    • 取引価格が高いと、モデルがうまく説明できなくなるのではないか。
    • デーラー経由だとセールス力があるため、値段が高騰する傾向があるのではないか?もしくは、査定代が取引価格に上乗せされているのではないか?

APPENDIX

予測値と残差

残渣(residuals)は、実際の値と予測値の差分で計算される。

以下の図だと、予測値の青の線と実際の値である赤の線の間が残差である。

# load packages
library(tidyverse)
library(modelr)
library(scales)
library(plotly)

# define the data for visualization
data_plot <- data %>%
  add_predictions(data.lm) %>% 
  add_residuals(data.lm) %>% 
  pivot_longer(cols = c(selling_price, pred, resid), names_to = "vars", values_to = "value")

# raw v.s. expected value
data_plot %>% 
  filter(vars != "resid") %>% 
  ggplot(aes(km_driven, value, lable = name, color = vars)) +
  geom_point() +
  geom_line() +
  scale_x_continuous(labels = comma) +
  scale_y_continuous(labels = comma) +
  labs(title = "The scatter plot of the predicted value",
       x = "Driven distance (km)",
       y = "Selling Price",
       color = "Name") +
  theme_minimal()

実際の値であるスピードの変化によって生じる残差の値を、グラフ化したのが以下の図になる。

library(ggrepel)

# residual  
g1 <- 
  data_plot %>% 
  filter(vars == "resid") %>% 
  ggplot(aes(km_driven, value, label = name)) +
  geom_hline(yintercept =  0, colour = "black", linetype = "dashed") +
  geom_point() +
  geom_line() +
  # geom_label_repel(nudge_x = TRUE, nudge_y = TRUE, check_overlap = TRUE) +
  labs(title = "The scatter plot of the residual",
       x = "Driven Distance (km)",
       y = "Residuals") +
  theme_minimal()

ggplotly(g1)